home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue29 / advpanel / ADVPANEL.ZIP / AdvPanel.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-11-14  |  16.9 KB  |  525 lines
  1. //======================== TAdvPanel 1.0 ====================================//
  2. //                                                                           //
  3. //  97/11/14                                                                 //
  4. //  by Charles Bedard                                                        //
  5. //                                                                           //
  6. //       see AdvPanel.txt for info on using this component                   //
  7. //                                                                           //
  8. //     *** You can distribute or modify this code at will, but               //
  9. //         please notify me about any change you make. The idea here         //
  10. //         is to see if i triggered some nice ideas on improving             //
  11. //         this kind of component                                            //
  12. //                                                                           //
  13. //===========================================================================//
  14.  
  15. unit AdvPanel;
  16.  
  17. interface
  18.  
  19. uses
  20.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  21.   ExtCtrls;
  22.  
  23. type
  24.   TFrameStyle = (fsNone, fsBump, fsCarved, fsLowered, fsRaised);
  25.   TFrameWidth = (fwSingle, fwThick);
  26.   THandleSize = 1..MaxInt;
  27.   THandleStyle = (hsNone, hsNormal, hs3D);
  28.  
  29.   TCustomAdvPanel = class(TCustomControl)
  30.   private
  31.     FFrameStyle : TFrameStyle;
  32.     FFrameWidth : TFrameWidth;
  33.     FMinSize    : integer;
  34.     FFullRepaint: Boolean;
  35.     FLocked     : Boolean;
  36.     FOnResize   : TNotifyEvent;
  37.     FAlignment  : TAlignment;
  38.     FHandleSize : THandleSize;
  39.     FHandleStyle: THandleStyle;
  40.     FResizing   : boolean;
  41.     OldMousePos : TPoint;
  42.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  43.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  44.     procedure CMIsToolControl(var Message: TMessage); message CM_ISTOOLCONTROL;
  45.     procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
  46.     procedure SetAlignment(Value: TAlignment);
  47.     procedure SetFrameStyle(Value: TFrameStyle);
  48.     procedure SetFrameWidth(Value: TFrameWidth);
  49.     procedure SetHandleSize(Value: THandleSize);
  50.     procedure SetHandleStyle(Value: THandleStyle);
  51.     function  GetFrameSize : integer;
  52.     function  GetHandleRect : TRect;
  53.     procedure DrawResizerRect(ScreenPos: TPoint);
  54.   protected
  55.     procedure CreateParams(var Params: TCreateParams); override;
  56.     procedure AlignControls(AControl: TControl; var Rect: TRect); override;
  57.     procedure Paint; override;
  58.     procedure Resize; dynamic;
  59.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override;
  60.     procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
  61.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override;
  62.     property Alignment  : TAlignment read FAlignment write SetAlignment default taCenter;
  63.     property FrameStyle : TFrameStyle read FFrameStyle write SetFrameStyle default fsRaised;
  64.     property FrameWidth : TFrameWidth read FFrameWidth write SetFrameWidth default fwSingle;
  65.     property HandleSize : THandleSize read FHandleSize write SetHandleSize default 4;
  66.     property HandleStyle: THandleStyle read FHandleStyle write SetHandleStyle default hsNormal;
  67.     property MinSize    : integer read FMinSize write FMinSize;
  68.     property Color        default clBtnFace;
  69.     property FullRepaint: Boolean read FFullRepaint write FFullRepaint default True;
  70.     property Locked     : Boolean read FLocked write FLocked default False;
  71.     property ParentColor  default False;
  72.     property OnResize   : TNotifyEvent read FOnResize write FOnResize;
  73.   public
  74.     constructor Create(AOwner: TComponent); override;
  75.   end;
  76.  
  77.   TAdvPanel = class(TCustomAdvPanel)
  78.   published
  79.     property Align;
  80.     property Alignment;
  81.     property DragCursor;
  82.     property DragMode;
  83.     property Enabled;
  84.     property FrameStyle;
  85.     property FrameWidth;
  86.     property HandleSize;
  87.     property HandleStyle;
  88.     property MinSize;
  89.     property FullRepaint;
  90.     property Caption;
  91.     property Color;
  92.     property Ctl3D;
  93.     property Font;
  94.     property Locked;
  95.     property ParentColor;
  96.     property ParentCtl3D;
  97.     property ParentFont;
  98.     property ParentShowHint;
  99.     property PopupMenu;
  100.     property ShowHint;
  101.     property TabOrder;
  102.     property TabStop;
  103.     property Visible;
  104.     property OnClick;
  105.     property OnDblClick;
  106.     property OnDragDrop;
  107.     property OnDragOver;
  108.     property OnEndDrag;
  109.     property OnEnter;
  110.     property OnExit;
  111.     property OnMouseDown;
  112.     property OnMouseMove;
  113.     property OnMouseUp;
  114.     property OnResize;
  115.     property OnStartDrag;
  116.   end;
  117.  
  118.  
  119. procedure Register;
  120.  
  121. implementation
  122.  
  123. procedure Register;
  124. begin
  125.   RegisterComponents('Samples', [TAdvPanel]);
  126. end;
  127.  
  128. constructor TCustomAdvPanel.Create(AOwner: TComponent);
  129. begin
  130.   inherited Create(AOwner);
  131.   ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
  132.     csSetCaption, csOpaque, csDoubleClicks, csReplicatable];
  133.   Width        := 185;
  134.   Height       := 41;
  135.   FAlignment   := taCenter;
  136.   FFrameStyle  := fsLowered;
  137.   FFrameWidth  := fwSingle;
  138.   FHandleSize  := 4;
  139.   FHandleStyle := hsNormal;
  140.   FMinSize     := 20;
  141.   Color        := clBtnFace;
  142.   FFullRepaint := True;
  143. end;
  144.  
  145. procedure TCustomAdvPanel.CreateParams(var Params: TCreateParams);
  146. begin
  147.   inherited CreateParams(Params);
  148. end;
  149.  
  150. procedure TCustomAdvPanel.CMTextChanged(var Message: TMessage);
  151. begin
  152.   Invalidate;
  153. end;
  154.  
  155. procedure TCustomAdvPanel.CMCtl3DChanged(var Message: TMessage);
  156. begin
  157.   inherited;
  158. end;
  159.  
  160. procedure TCustomAdvPanel.CMIsToolControl(var Message: TMessage);
  161. begin
  162.   if not FLocked then Message.Result := 1;
  163. end;
  164.  
  165. procedure TCustomAdvPanel.Resize;
  166. begin
  167.   if Assigned(FOnResize) then FOnResize(Self);
  168. end;
  169.  
  170. function TCustomAdvPanel.GetFrameSize : integer;
  171. begin
  172.   case FrameStyle of
  173.     fsNone             : result := 0;
  174.     fsLowered,fsRaised : result := 1;
  175.     fsCarved,fsBump    : result := 2;
  176.   end;
  177.   if FrameWidth = fwThick then
  178.     Inc(result, result);
  179. end;
  180.  
  181. function TCustomAdvPanel.GetHandleRect : TRect;
  182. begin
  183.   case Align of
  184.      alTop    : result := Rect(0,Height-HandleSize,Width,Height);
  185.      alBottom : result := Rect(0,0,Width,HandleSize);
  186.      alLeft   : result := Rect(Width-HandleSize,0,Width,Height);
  187.      alRight  : result := Rect(0,0,HandleSize,Height);
  188.      else result := Rect(0,0,0,0);
  189.   end;
  190. end;
  191.  
  192. procedure TCustomAdvPanel.WMWindowPosChanged(var Message: TWMWindowPosChanged);
  193. var
  194.   FramePixels : Integer;
  195.   Rect        : TRect;
  196. begin
  197.   if FullRepaint or (Caption <> '') then
  198.     Invalidate
  199.   else
  200.   begin
  201.     FramePixels := GetFrameSize;
  202.     if FramePixels > 0 then
  203.     begin
  204.       Rect.Right  := Width;
  205.       Rect.Bottom := Height;
  206.       if Message.WindowPos^.cx <> Rect.Right then
  207.       begin
  208.         Rect.Top := 0;
  209.         Rect.Left := Rect.Right - FramePixels - 1;
  210.         InvalidateRect(Handle, @Rect, True);
  211.       end;
  212.       if Message.WindowPos^.cy <> Rect.Bottom then
  213.       begin
  214.         Rect.Left := 0;
  215.         Rect.Top := Rect.Bottom - FramePixels - 1;
  216.         InvalidateRect(Handle, @Rect, True);
  217.       end;
  218.     end;
  219.   end;
  220.   inherited;
  221.   if not (csLoading in ComponentState) then Resize;
  222. end;
  223.  
  224. procedure TCustomAdvPanel.AlignControls(AControl: TControl; var Rect: TRect);
  225. var
  226.   FrameSize: Integer;
  227. begin
  228.   FrameSize := GetFrameSize;
  229.   InflateRect(Rect, -FrameSize, -FrameSize);
  230.   case Align of
  231.     alTop    : Dec(Rect.Bottom,HandleSize+1);
  232.     alBottom : Inc(Rect.Top,HandleSize+1);
  233.     alLeft   : Dec(Rect.Right,HandleSize+1);
  234.     alRight  : Inc(Rect.Left,HandleSize+1);
  235.   end;
  236.   inherited AlignControls(AControl, Rect);
  237. end;
  238.  
  239.  
  240. procedure TCustomAdvPanel.MouseDown(Button: TMouseButton; Shift: TShiftState; X,Y: Integer);
  241. var
  242.    R: TRect;
  243.    CurrPos : TPoint;
  244.    ParentPos : TPoint;
  245. begin
  246.   inherited MouseDown(Button,Shift,X,Y);
  247.   FResizing := False;
  248.   R := GetHandleRect;
  249.   CurrPos     := Point(X,Y);
  250.   OldMousePos := ClientToScreen(CurrPos);
  251.   if (Button = mbLeft) and PtInRect(R,CurrPos) then begin
  252.     DrawResizerRect(OldMousePos);
  253.     FResizing := True;
  254.   end;
  255. end;
  256.  
  257. procedure TCustomAdvPanel.DrawResizerRect(ScreenPos: TPoint);
  258. var
  259.    ParentDC: HDC;
  260.    R: TRect;
  261.    HS : integer;
  262. begin
  263.   ScreenPos := Parent.ScreenToClient(ScreenPos);
  264.   HS := HandleSize div 2;
  265.   case Align of
  266.      alTop    : R := Rect(Left,ScreenPos.Y - HS,Width,HandleSize);
  267.      alBottom : R := Rect(Left,ScreenPos.Y - HS,Width,HandleSize);
  268.      alRight  : R := Rect(ScreenPos.X - HS,Top,handleSize,Height);
  269.      alLeft   : R := Rect(ScreenPos.X - HS,Top,handleSize,Height);
  270.   end;
  271.   ParentDC := GetDCEx(Parent.Handle, 0, DCX_CACHE or DCX_CLIPSIBLINGS
  272.   or DCX_LOCKWINDOWUPDATE);
  273.   PatBlt(ParentDC,R.Left,R.Top,R.Right,R.Bottom,DSTINVERT);
  274.   ReleaseDC(Parent.Handle, ParentDC);
  275. end;
  276.  
  277. procedure TCustomAdvPanel.MouseMove(Shift: TShiftState; X,Y: Integer);
  278. var
  279.    dx,dy,HS,
  280.    NewSize   : integer;
  281.    CurrPos,
  282.    ParentPos : TPoint;
  283.    R         : TRect;
  284. begin
  285.   inherited MouseMove(Shift,X,Y);
  286.   if (FResizing) then begin
  287.     { erase old rect }
  288.     DrawResizerRect(OldMousePos);
  289.     HS := HandleSize div 2;
  290.     CurrPos := ClientToScreen(Point(X,Y));
  291.     ParentPos := Parent.ScreenToClient(CurrPos);
  292.     dx := CurrPos.X - OldMousePos.X;
  293.     dy := CurrPos.Y - OldMousePos.Y;
  294.     case Align of
  295.       alTop    : if (dy <> 0) then begin
  296.                    NewSize := ParentPos.Y - HS;
  297.                    if (NewSize < MinSize) or (NewSize > Parent.ClientHeight - MinSize) then
  298.                      CurrPos := OldMousePos;
  299.                    DrawResizerRect(CurrPos);
  300.                  end;
  301.       alBottom : if (dy <> 0) then begin
  302.                    NewSize := Parent.ClientHeight - ParentPos.Y - HS;
  303.                    if (NewSize < MinSize) or (NewSize > Parent.ClientHeight - MinSize) then
  304.                      CurrPos := OldMousePos;
  305.                    DrawResizerRect(CurrPos);
  306.                  end;
  307.       alLeft   : if (dx <> 0) then begin
  308.                    NewSize := ParentPos.X - HS;
  309.                    if (NewSize < MinSize) or (NewSize > Parent.ClientWidth - MinSize) then
  310.                      CurrPos := OldMousePos;
  311.                    DrawResizerRect(CurrPos);
  312.                  end;
  313.       alRight  : if (dx <> 0) then begin
  314.                    NewSize := Parent.ClientWidth - ParentPos.X - HS;
  315.                    if (NewSize < MinSize) or (NewSize > Parent.ClientWidth - MinSize) then
  316.                      CurrPos := OldMousePos;
  317.                    DrawResizerRect(CurrPos);
  318.                  end;
  319.     end;
  320.     OldMousePos := CurrPos;
  321.   end
  322.   else begin
  323.     R := GetHandleRect;
  324.     if PtInRect(R,Point(X,Y)) then
  325.       case Align of
  326.         alTop,alBottom : cursor := crVSplit;
  327.         alLeft,alRight : cursor := crHSplit;
  328.       end
  329.     else cursor := crDefault;
  330.   end;
  331. end;
  332.  
  333. procedure TCustomAdvPanel.MouseUp(Button: TMouseButton; Shift: TShiftState; X,Y: Integer);
  334. var
  335.    NewSize   : Integer;
  336.    ParentPos : TPoint;
  337.    HS        : Integer;
  338. begin
  339.   if FResizing then begin
  340.      { erase old rect }
  341.      DrawResizerRect(OldMousePos);
  342.      HS := HandleSize div 2;
  343.      ParentPos := ClientToScreen(Point(X,Y));
  344.      ParentPos := Parent.ScreenToClient(ParentPos);
  345.      case Align of
  346.         alTop    : begin
  347.                      NewSize := ParentPos.Y - HS;
  348.                      if (NewSize < MinSize) then
  349.                        NewSize := MinSize;
  350.                      if (NewSize > Parent.ClientHeight - MinSize) then
  351.                        NewSize := Parent.ClientHeight - MinSize;
  352.                      Height := NewSize + HandleSize;
  353.                    end;
  354.         alBottom : begin
  355.                      NewSize := Parent.ClientHeight - ParentPos.Y - HS;
  356.                      if (NewSize < MinSize) then
  357.                        NewSize := MinSize;
  358.                      if (NewSize > Parent.ClientHeight - MinSize) then
  359.                        NewSize := Parent.ClientHeight - MinSize;
  360.                      Height := NewSize + HandleSize;
  361.                    end;
  362.         alLeft   : begin
  363.                      NewSize := ParentPos.X - HS;
  364.                      if (NewSize < MinSize) then
  365.                        NewSize := MinSize;
  366.                      if (NewSize > Parent.ClientWidth - MinSize) then
  367.                        NewSize := Parent.ClientWidth - MinSize;
  368.                      Width := NewSize + HandleSize;
  369.                    end;
  370.         alRight  : begin
  371.                      NewSize := Parent.ClientWidth - ParentPos.X - HS;
  372.                      if (NewSize < MinSize) then
  373.                        NewSize := MinSize;
  374.                      if (NewSize > Parent.ClientWidth - MinSize) then
  375.                        NewSize := Parent.ClientWidth - MinSize;
  376.                      Width := NewSize + HandleSize;
  377.                    end;
  378.      end;
  379.   end;
  380.   FResizing := False;
  381.   inherited MouseUp(Button,Shift,X,Y);
  382. end;
  383.  
  384.  
  385. procedure TCustomAdvPanel.Paint;
  386. var
  387.   R  : TRect;
  388.   FW : integer;
  389.   FontHeight: Integer;
  390. const
  391.   Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  392.  
  393. begin
  394.   R := GetClientRect;
  395.   with Canvas do
  396.   begin
  397.     { fill background }
  398.     Brush.Color := Color;
  399.     FillRect(R);
  400.  
  401.     { Adjust ClientRect depending on alignement }
  402.     case Align of
  403.       alTop    : Dec(R.Bottom,HandleSize+1);
  404.       alBottom : Inc(R.Top,HandleSize+1);
  405.       alLeft   : Dec(R.Right,HandleSize+1);
  406.       alRight  : Inc(R.Left,HandleSize+1);
  407.     end;
  408.  
  409.     { Draw the Frame }
  410.     FW   := GetFrameSize;
  411.     if FW > 0 then
  412.       case FrameStyle of
  413.         fsBump   : begin
  414.                      FW := FW div 2;
  415.                      Frame3D(Canvas,R,clBtnHighLight,clBtnShadow,FW);
  416.                      Frame3D(Canvas,R,clBtnShadow,clBtnHighLight,FW);
  417.                    end;
  418.         fsCarved : begin
  419.                      FW := FW div 2;
  420.                      Frame3D(Canvas,R,clBtnShadow,clBtnHighLight,FW);
  421.                      Frame3D(Canvas,R,clBtnHighLight,clBtnShadow,FW);
  422.                    end;
  423.         fsLowered: Frame3D(Canvas,R,clBtnShadow,clBtnHighLight,FW);
  424.         fsRaised : Frame3D(Canvas,R,clBtnHighLight,clBtnShadow,FW);
  425.     end;
  426.  
  427.     Brush.Style := bsClear;
  428.     Font := Self.Font;
  429.     FontHeight := TextHeight('W');
  430.     with R do
  431.     begin
  432.       Top := ((Bottom + Top) - FontHeight) div 2;
  433.       Bottom := Top + FontHeight;
  434.     end;
  435.     DrawText(Handle, PChar(Caption), -1, R, (DT_EXPANDTABS or
  436.       DT_VCENTER) or Alignments[FAlignment]);
  437.  
  438.     { draw the resize handle }
  439.     if HandleStyle = hsNone then Exit;
  440.  
  441.     if HandleStyle = hs3D then
  442.       FW := 1
  443.     else FW := 0;
  444.     pen.width := 2;
  445.     case Align of
  446.       alTop    : begin
  447.                    pen.Color := clBtnShadow;
  448.                    MoveTo(0,Height-FW);
  449.                    LineTo(Width,Height-FW);
  450.                    if HandleStyle = hs3D then begin
  451.                      pen.Color := clBtnHighLight;
  452.                      MoveTo(0,Height-HandleSize);
  453.                      LineTo(Width,Height-HandleSize);
  454.                    end;
  455.                  end;
  456.       alBottom : begin
  457.                    pen.Color := clBtnHighLight;
  458.                    MoveTo(0,FW);
  459.                    LineTo(Width,FW);
  460.                    if HandleStyle = hs3D then begin
  461.                      pen.Color := clBtnShadow;
  462.                      MoveTo(0,HandleSize);
  463.                      LineTo(Width,HandleSize);
  464.                    end;
  465.                  end;
  466.       alLeft   : begin
  467.                    pen.Color := clBtnShadow;
  468.                    MoveTo(Width-FW,0);
  469.                    LineTo(Width-FW,Height);
  470.                    if HandleStyle = hs3D then begin
  471.                      pen.Color := clBtnHighLight;
  472.                      MoveTo(Width-HandleSize,0);
  473.                      LineTo(Width-HandleSize,Height);
  474.                    end;
  475.                  end;
  476.       alRight  : begin
  477.                    pen.Color := clBtnHighLight;
  478.                    MoveTo(FW,0);
  479.                    LineTo(FW,Height);
  480.                    if HandleStyle = hs3D then begin
  481.                      pen.Color := clBtnShadow;
  482.                      MoveTo(HandleSize,0);
  483.                      LineTo(HandleSize,Height);
  484.                    end;
  485.                  end;
  486.     end;
  487.   end;
  488. end;
  489.  
  490. procedure TCustomAdvPanel.SetAlignment(Value: TAlignment);
  491. begin
  492.   FAlignment := Value;
  493.   Invalidate;
  494. end;
  495.  
  496. procedure TCustomAdvPanel.SetFrameStyle(Value: TFrameStyle);
  497. begin
  498.   FFrameStyle := Value;
  499.   Realign;
  500.   Invalidate;
  501. end;
  502.  
  503. procedure TCustomAdvPanel.SetFrameWidth(Value: TFrameWidth);
  504. begin
  505.   FFrameWidth := Value;
  506.   Realign;
  507.   Invalidate;
  508. end;
  509.  
  510. procedure TCustomAdvPanel.SetHandleSize(Value: THandleSize);
  511. begin
  512.   FHandleSize := Value;
  513.   Realign;
  514.   Invalidate;
  515. end;
  516.  
  517. procedure TCustomAdvPanel.SetHandleStyle(Value: THandleStyle);
  518. begin
  519.   FHandleStyle := Value;
  520.   invalidate;
  521. end;
  522.  
  523.  
  524. end.
  525.